home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb1 / pro2 / keyboard.bas < prev    next >
BASIC Source File  |  1992-03-21  |  10KB  |  236 lines
  1. DEFINT A-Z
  2. '+==================================================================+
  3. '|                           KEYBOARD.BAS                           |
  4. '|                                                                  |
  5. '|  A set of input routines developed by Larry Stone and the SWOCC  |
  6. '|  students of Larry Stone, CS133B, Fall Term '91, SWOCC.          |
  7. '+------------------------------------------------------------------+
  8. '
  9. DECLARE FUNCTION InsertState% ()
  10. DECLARE FUNCTION KeyPressed% ()
  11. DECLARE FUNCTION Lower% (Value%)
  12. DECLARE FUNCTION Upper% (Value%)
  13.  
  14. CONST True = -1
  15. CONST False = 0
  16.  
  17. '+==================================================================+
  18. '|                            SUBPROGRAMS                           |
  19. '+------------------------------------------------------------------+
  20.  
  21. FUNCTION InsertState%
  22.  
  23.     '---- Insert is either On or Off and InsertState% is set to True or False
  24.     DEF SEG = False                         'Go to ROM segment
  25.     InsertState% = (PEEK(&H417) AND 128) = 128  '1000 0000
  26.     DEF SEG                                 'Back to BASIC DGROUP
  27.  
  28. END FUNCTION
  29.  
  30. '+==============================================================+
  31. '|                     KeyPressed% FUNCTION                     |
  32. '|                                                              |
  33. '|  Input:  Nothing                                             |
  34. '|  Return: The function returns an integer representing the    |
  35. '|          ASCII value of a keystroke.  If an extended key     |
  36. '|          value is returned from the keyboard buffer then the |
  37. '|          right byte (scan code) is returned as a negative    |
  38. '|          value.  If no keystroke is pending in the keyboard  |
  39. '|          buffer then zero is returned.                       |
  40. '+--------------------------------------------------------------+
  41. FUNCTION KeyPressed%
  42.  
  43.     Temp$ = INKEY$               'Get a keystroke from the keyboard buffer
  44.  
  45.     IF LEN(Temp$) THEN           'If we got a key from the buffer
  46.  
  47.         '---- Set value representing the right byte
  48.         AsciiValue = ASC(RIGHT$(Temp$, 1))
  49.  
  50.         '---- If extended key value then flag it so by changing its sign
  51.         IF LEN(Temp$) = 2 THEN AsciiValue = -AsciiValue
  52.     ELSE                         'No key value found in keyboard buffer
  53.  
  54.         AsciiValue = False       'So, set value to zero
  55.     END IF
  56.  
  57.     KeyPressed = AsciiValue      'Set the function to value derived
  58.  
  59. END FUNCTION
  60.  
  61. '+==============================================================+
  62. '|                        Lower% FUNCTION                       |
  63. '|                                                              |
  64. '|  Input:  An INTEGER value.                                   |
  65. '|  Return: The function returns the integer, unaltered, if     |
  66. '|          the value of the INTEGER is outside of the lower    |
  67. '|          case letter range.  If the INTEGER is between 65    |
  68. '|          and 90 (ASCII for 'A' through 'Z') then 32 is ORed  |
  69. '|          (added), resulting in a return value of 97 through  |
  70. '|          122 (ASCII for 'a' through 'z').                    |
  71. '+--------------------------------------------------------------+
  72. FUNCTION Lower% (Value%)
  73.     IF Value > 64 AND Value < 91 THEN Lower = Value OR 32 ELSE Lower = Value
  74. END FUNCTION
  75.  
  76. '+==============================================================+
  77. '|                      RingSound SUBPROGRAM                    |
  78. '|                                                              |
  79. '|  Input:    Nothing                                           |
  80. '|  Return:   Nothing                                           |
  81. '|  Purpose:  Produces a more pleasing sound than BEEP.         |
  82. '|            Does not use floating point library.              |
  83. '|                                                              |
  84. '+--------------------------------------------------------------+
  85. SUB RingSound
  86.  
  87.     OUT &H43, 182                   ' set up for sound
  88.     OUT &H42, &H33                  ' low part of sound
  89.     OUT &H42, 5                     ' high part of sound
  90.     N = INP(&H61)                   ' get byte value from port
  91.     N1 = N                          ' save value as N1
  92.     N = N OR 3                      ' set bits 0 and 1 to o«
  93.       CLS
  94.  
  95.     Frame.boxType = 2: Frame.filClr = 3     'Define the frame parameters
  96.     Frame.fore = 15: Frame.back = 1
  97.     Frame.lftCol = 1: Frame.rgtCol = 80
  98.     Frame.tRow = 1: Frame.bRow = 13
  99.  
  100.     Box Frame                               'Draw frame for input fields
  101.  
  102.     Frame.back = 4: Frame.filClr = 4
  103.     Frame.tRow = 15: Frame.bRow = 19
  104.     Frame.boxType = 4: Box Frame            'Draw frame for edit help box
  105.  
  106.     COLOR 1, 3                              'Tell user what process is
  107.     LOCATE 3, 32
  108.     PRINT "Edit Data Routine"
  109.  
  110.     LOCATE 11, 3: COLOR 4, 3                'Display brief help message
  111.     PRINT "Use: "; CHR$(24); " "; CHR$(25); " PgUp PgDn.  <Enter> on last entry to process changes.  <Esc>: Abort"
  112.  
  113.     COLOR 15, 3                             'Finish setting up the form
  114.     LOCATE 5, 3: PRINT "Last/First => ";
  115.     LOCATE , 37: PRINT ","
  116.     LOCATE 6, 3: PRINT "Address => "
  117.     LOCATE 7, 3: PRINT "Telephone => (   )   -";
  118.     LOCATE 8, 3: PRINT "Memo => "
  119.     LOCATE 9, 3: PRINT "Save To => "
  120.  
  121.     COLOR 15, 4                             'Messages inside of Help Box
  122.     LOCATE 16, 33: PRINT "Editor Commands"
  123.     LOCATE 17, 4
  124.     PRINT "Scroll line:    ─"; CHR$(16); "    "; CHR$(17); "─    <Home>    <End>    <Ctrl> + ─"; CHR$(16); "    <Ctrl> + "; CHR$(17); "─"
  125.     LOCATE 18, 4
  126.     PRINT "Delete with:    <Delete>    <Backspace>   <Ctrl> + <Home>   <Ctrl> + <End>"
  127.  
  128.     COLOR 15, 5
  129.     FOR N = 1 TO MaxChoice
  130.         LOCATE EditRow%(N), EditCol(N)
  131.         PRINT LEFT$(EditStrings$(N) + SPACE$(DisplaySize(N)), DisplaySize(N))
  132.     NEXT
  133. RETURN
  134.  
  135. DefineEditorVariables:
  136.     '---- Initialize LineEdit's Terminators array.  Terminators are
  137.     '     REQUIRED by the editor.  The zeroeth element of the array
  138.     '     defines how many elements the editor will use.
  139.     Terminators(False) = 5              'Only using first 5 for right now
  140.     Terminators(1) = 27                 'Terminate on Esc key
  141.     Terminators(2) = -72                'Terminate on Up arrow
  142.     Terminators(3) = -80                'Terminate on Down arrow
  143.     Terminators(4) = -73                'Terminate on Page Up
  144.     Terminators(5) = -81                'Terminate on Page Down
  145.  
  146.     '---- These terminators are not used in this demo example.  We've
  147.     '     DIMmed Terminators (10) so 2 more can still be defined.
  148.     Terminators(6) = -132               'Terminate on Ctrl + Page Up
  149.     Terminators(7) = -118               'Terminate on Ctrl + Page Down
  150.     Terminators(8) = -68                'Terminate on F10 key
  151.  
  152.     '---- Initialize LineEdit's word separater string
  153.     Separaters$ = " .:-(){}\/"
  154.  
  155.     '---- Define some data.  Note data could be retrieved from file or DATA
  156.     EditStrings$(1) = "Stone"
  157.     EditRow%(1) = 5
  158.     EditCol(1) = 17
  159.     WindSize(1) = False
  160.     DisplaySize(1) = 20
  161.     '---- "A*" + string "a"
  162.     EditMask$(1) = LEFT$("A*" + STRING$(DisplaySize(1), 97), DisplaySize(1))
  163.     
  164.     EditStrings$(2) = "Lawrence"
  165.     EditRow%(2) = 5
  166.     EditCol(2) = 39
  167.     WindSize(2) = False
  168.     DisplaySize(2) = 20
  169.     '---- "A" + string "*"
  170.     EditMask$(2) = LEFT$("A" + STRING$(DisplaySize(2), 42), DisplaySize(2))
  171.  
  172.     EditStrings$(3) = "1234"
  173.     EditRow%(3) = 6
  174.     EditCol(3) = 14
  175.     WindSize(3) = False
  176.     DisplaySize(3) = 9
  177.     EditMask$(3) = STRING$(DisplaySize(3), "8")
  178.     
  179.     EditStrings$(4) = "Main Street"
  180.     EditRow%(4) = 6
  181.     EditCol(4) = 24
  182.     WindSize(4) = False
  183.     DisplaySize(4) = 35
  184.    
  185.     EditStrings$(5) = "503"
  186.     EditRow%(5) = 7
  187.     EditCol(5) = 17
  188.     WindSize(5) = False
  189.     DisplaySize(5) = 3
  190.     EditMask$(5) = STRING$(DisplaySize(5), "9")
  191.  
  192.     EditStrings$(6) = "756"
  193.     EditRow%(6) = 7
  194.     EditCol(6) = 21
  195.     WindSize(6) = False
  196.     DisplaySize(6) = 3
  197.     EditMask$(6) = STRING$(DisplaySize(6), "9")
  198.     
  199.     EditStrings$(7) = "5935"
  200.     EditRow%(7) = 7
  201.     EditCol(7) = 25
  202.     WindSize(7) = False
  203.     DisplaySize(7) = 4
  204.     EditMask$(7) = STRING$(DisplaySize(7), "9")
  205.  
  206.     EditStrings$(8) = "Now is the time for all good men to come to the aid of their "
  207.     EditStrings$(8) = EditStrings$(8) + "fellow countrymen.  In the land of the blind, the one-"
  208.     EditStrings$(8) = EditStrings$(8) + "eyed man is king.  Good QB programmers always respond "
  209.     EditStrings$(8) = EditStrings$(8) + "to a challange and, in so doing, become better programmers."
  210.     EditRow%(8) = 8
  211.     EditCol(8) = 11
  212.     WindSize(8) = 300
  213.     DisplaySize(8) = 67
  214.     
  215.     EditStrings$(9) = "C:\BASIC\STUFF\PERSONAL.DAT"
  216.     EditRow%(9) = 9
  217.     EditCol(9) = 14
  218.     WindSize(9) = False
  219.     DisplaySize(9) = 64
  220. RETURN
  221.  
  222. '+==================================================================+
  223. '|                            SUBPROGRAMS                           |
  224. '+------------------------------------------------------------------+
  225.  
  226. &HB809
  227.   INTERRUPT &H2F, Registers, Registers
  228.   Major% = Registers.ax \ 256            ' AH
  229.   Minor% = Registers.ax - (Major * 256)  ' AL
  230. END SUB
  231.  
  232. SUB Redirect (DevType%, DevName$, NetPath$)      ' Redirect a device
  233.   'ND Value < 123 THEN Upper = Value AND 223 ELSE Upper = Value
  234. END FUNCTION
  235.  
  236.